home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Pascal Super Library
/
Pascal Super Library (CW International)(1997).bin
/
TSR
/
PPTSR10
/
FUNFUNK.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-12
|
4KB
|
189 lines
(*
Program : funfunk.pas
Function : Example TSR program. Screen saver.
From : DOS International, June 1992
Modified : P.Peters
Date : June 1992
*)
program funfunk;
{$m $1000,0,0}
{$r-,s-,x+}
uses
crt,tsr;
type
buffer = array[1..4000] of byte;
const
idcode = $c0;
smileys : word = 100;
wait : word = 1;
var
scrbuf : buffer;
procedure smile; far;
var
scrmem : ^buffer;
smiley : word;
x : word;
begin
case mem[$40:$49] of
3 : scrmem := ptr($b800,0);
7 : scrmem := ptr($b000,0);
else
for x := 1 to 8 do begin
sound(x*1000);
delay(20);
nosound;
delay(20);
end;
exit;
end;
move(scrmem^,scrbuf,sizeof(scrbuf));
repeat
if (random(2000) > 2000-smileys) then
smiley := (random(14)+1) shl 8 + 1
else
smiley := 0;
move(smiley,scrmem^[1+random(2000)*2],2);
delay(wait);
until keypressed;
repeat
readkey;
until not keypressed;
move(scrbuf,scrmem^,sizeof(scrbuf));
end;
(* a user defined int 2f procedure is called when int 2f executed
* and al >= 2. ah is cleared before calling this procedure
*)
procedure hook2f; far; assembler;
label
tst3, tst4, fin;
asm
cmp ax,2 {set delay}
jne tst3
mov wait,cx
tst3:
cmp ax,3 {set # smileys}
jne tst4
mov smileys,cx
tst4:
cmp ax,4 {read delay and # smileys}
jne fin
mov bx,wait
mov cx,smileys
fin:
end;
var
num : word;
procedure paramcheck; far;
var
s : string;
i : byte;
function makenum( max : integer ) : boolean;
var
code : integer;
begin
delete(s,1,1);
val(s,num,code);
makenum := (code=0) and (num <= max);
end;
procedure senddelay;
begin
if makenum(25) then begin
if tsrloaded then
asm
mov cx,num
mov ax,idcode shl 8 + 2
int 2fh
end
else
wait := num;
writeln('Delay : ',num);
end else
writeln('Invalid parameter : ',s);
end;
procedure sendsmileys;
begin
if makenum(2000) then begin
if tsrloaded then
asm
mov cx,num
mov ax,idcode shl 8 + 3
int 2fh
end
else
smileys := num;
writeln(num,' Smileys');
end else
writeln('Invalid parameter : ',s);
end;
procedure getinfo;
begin
if tsrloaded then begin
asm
mov ax,idcode shl 8 + 4
int 2fh
mov wait,bx
mov smileys,cx
end;
writeln('Info from Tsr');
writeln(' Delay : ',wait);
writeln(' Smileys : ',smileys);
end else begin
writeln('Tsr receiver not installed.');
halt;
end;
end;
procedure writeopt;
begin
writeln('Usage:');
writeln(' FunFunk [Option]');
writeln('Options:');
writeln(' /u Remove Tsr');
writeln(' /d0..25 Delay');
writeln(' /s0..2000 Number of smileys');
writeln(' /i Info from Tsr');
halt;
end;
begin {paramcheck}
if paramcount > 0 then
for i := 1 to paramcount do begin
s := paramstr(i);
s[1] := upcase(s[1]);
if s[1] = '/' then begin (* switch *)
delete(s,1,1);
s[1] := upcase(s[1]);
case s[1] of
'D' : senddelay;
'S' : sendsmileys;
'I' : getinfo;
'?' : writeopt;
else begin
writeln('Invalid switch : ',s);
writeopt;
end;
end;
end else begin (* no switch *)
writeln('Invalid parameter : ',s);
writeopt;
end;
end;
end;
begin
writeln('FunFunk Tsr-Testprogram'^m^j);
tsrinstall('[Alt][F10]',$7100,idcode,smile,hook2f,paramcheck);
end.